home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MAIL.SWG / 0003_MSGINFO.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  173 lines
  1. Program VERBOSITY_INDEX;
  2. {
  3. JUSTIN MARQUEZ
  4.  
  5.   Reads a FidoNet *.MSG File areas and logs info about authorship and
  6.   "verbosity" found in the messages.
  7.  
  8.   Requires Turbo Pascal 7.xx or Borland Pascal 7.xx (for the StringS Unit)
  9.  
  10.   OutPut is redirectable.  Can be quickly sorted With Dos's SORT.COM
  11.   Here is a batch File you may find useful:
  12.  
  13. rem YAK.BAT
  14. verbose %1 > zap.txt
  15. sort < zap.txt > yak.txt /+37 /R
  16. del zap.txt
  17.  
  18.    This Program is written by Justin Marquez, FidoNet 106/100
  19.    It is being donated to all as a PUBLIC DOMAIN Program, which may be
  20.    freely used, copied and modified as you please.
  21.  
  22.    "if you improve on it, I'd like a copy of the modifications For my
  23.    own edification!"
  24. }
  25.  
  26. Uses
  27.   Strings,
  28.   Dos;
  29.  
  30. Type
  31.   FidoMessageHeader = Record
  32.     FromUser  : Array[0..35] of Char ;
  33.     ToUser    : Array[0..35] of Char ;
  34.     Subject   : Array[0..71] of Char ;
  35.     DateTime  : Array[0..19] of Char ;
  36.     TimesRead : Word ;
  37.     DestNode  : Word ;
  38.     OrigNode  : Word ;
  39.     Cost      : Word ;
  40.     OrigNet   : Word ;
  41.     DestNet   : Word ;
  42.     Filler    : Array[0..7] of Byte ;
  43.     Replyto   : Word ;
  44.     Attribute : Word ;
  45.     NextReply : Word ;
  46.   end;
  47.  
  48.   Entry = Record
  49.     Author : String[36];
  50.     Count  : Integer;
  51.     Bytes  : LongInt;
  52.   end;
  53.  
  54. Var
  55.   MsgDir,
  56.   fn       : String;
  57.   SR       : SearchRec;
  58.   tmp      : FidoMessageHeader;
  59.   Who_From : String[36];
  60.   n,
  61.   i        : Integer;
  62.   HiNum    : Integer;
  63.   rec      : Array [1..512] of Entry;
  64.   TotBytes : LongInt;
  65.  
  66. Procedure GetMsgInfo (fname : String; Var Hdr : FidoMessageHeader);
  67. Var
  68.   HFile : File of FidoMessageHeader;
  69.   MFile : Text;
  70. begin
  71.   FillChar(Hdr, SizeOf(Hdr), #0);  { clear it out initially }
  72.   { get msg hdr only }
  73.   Assign(HFile,fname);
  74.   Reset(HFile);
  75.   Seek(HFile, 0);
  76.   Read(HFile, Hdr);
  77.   Close(HFile);
  78. end;
  79.  
  80. Procedure Pad_Path(Var s : String);
  81. begin
  82.   if s[length(s)] <> '\' then
  83.     s := s + '\';
  84. end;
  85.  
  86. Procedure Process_Name;
  87. Var
  88.   k : Integer;
  89.   Found : Boolean;
  90. begin
  91.   Found := False;
  92.   if n > 0 then
  93.     For k := 1 to n do
  94.       if Who_From = rec[k].author then
  95.       begin
  96.         inc(rec[k].count);
  97.         rec[k].Bytes := rec[k].Bytes + SR.Size;
  98.         Found := True;
  99.       end
  100.   else
  101.   begin
  102.     rec[1].author := Who_From;
  103.     rec[1].count  := 1;
  104.     rec[1].Bytes := rec[1].Bytes + SR.Size
  105.   end;
  106.   if not Found then
  107.   begin
  108.     inc(n);
  109.     Rec[n].Author := Who_From;
  110.     Rec[n].Count  := 1;
  111.     rec[n].Bytes  := rec[n].Bytes + SR.Size;
  112.   end;
  113. end;
  114.  
  115. Procedure Intro_And_Init;
  116. begin
  117.   FillChar(rec,SizeOf(rec),#0);  { clear it out initially }
  118.   HiNum    := 0;
  119.   TotBytes := 0;
  120.   n        := 0;
  121.   if ParamCount > 0 then
  122.     MsgDir := ParamStr(1)
  123.   else
  124.   begin
  125.     WriteLn(' VERBOSE <path> >');
  126.     WriteLn('EXAMPLE:');
  127.     WriteLn;
  128.     WriteLn('VERBOSE C:\OPUS\HOUSYSOP\ ');
  129.     WriteLn(' reads all msg Files in the area and reports findings.');
  130.     WriteLn;
  131.     WriteLn(' Note: can be redirected to a File or device.');
  132.     WriteLn;
  133.     WriteLn('Public Domain from 106/100. Request as VERBOSE.ZIP.');
  134.     Halt(2);
  135.   end;
  136. end;
  137.  
  138. Procedure Process_Files;
  139. begin
  140.   Pad_Path(MsgDir);
  141.   fn := MsgDir + '*.MSG';
  142.   FindFirst(fn, AnyFile, SR);
  143.   While DosError = 0 do
  144.   begin
  145.     fn := MsgDir + SR.Name;
  146.     GetMsgInfo (fn, tmp);
  147.     Who_From := '';
  148.     Who_From := StrPas(StrUpper(tmp.FromUser));
  149.     Inc(HiNum);
  150.     TotBytes := TotBytes + SR.Size;
  151.     Process_Name;
  152.     FindNext(SR);
  153.   end;
  154. end;
  155.  
  156. Procedure Report_Results;
  157. begin
  158.   For i := 1 to n do
  159.     WriteLn(rec[i].Author : 36, Rec[i].Count : 4,
  160.            (100 * Rec[i].Count / HiNum) : 6 : 1, '% ',
  161.             Rec[i].Bytes : 6, ' Bytes or',
  162.            (100 * Rec[i].Bytes / TotBytes) : 5 : 1, '% by size' );
  163.   WriteLn(' Total messages found: ' : 36, HiNum : 4);
  164.   WriteLn(' Total Bytes found   : ' : 36, TotBytes : 18);
  165.   WriteLn(n, ' different Writers found in ', MsgDir, '.');
  166. end;
  167.  
  168. begin
  169.   Intro_And_Init;
  170.   Process_Files;
  171.   Report_Results;
  172. end.
  173.